\documentclass{article}
\usepackage{fancyhdr,palatino,setspace,amsmath}
\usepackage{hyperref,float}

\title{Appendix to Life-or-Death Framing of Public-Health Policy in a Pandemic}
\begin{document}
\maketitle

\setcounter{figure}{0}
\makeatletter 
\renewcommand{\thefigure}{A\arabic{figure}}

\setcounter{table}{0}
\makeatother
\renewcommand{\thetable}{A\arabic{table}}

\section*{Difference Tests}

Figure 1 in the article shows weighted proportions. Unweighted $N$s and proportions selecting each response option are reported in Table A1 below. 

<<opendata,echo=F,results='asis',warning=F,message=F>>=
rm(list=ls())
#library(foreign)
library(abtest)
#ccdat<-read.spss("~/Dropbox/CCES20/CCES20_UIL_OUTPUT.sav",
#                  to.data.frame = TRUE, use.value.labels = TRUE)

load(file="~/Dropbox/CCES20/jeps.bjg.sav")

# weighted
T1<-matrix(0,nrow=3,ncol=2)
# A. gains, C. both, B. losses
ADT<-c("UIL368A","UIL368C","UIL368B") 
RO1<-c("Option 1","Option 2")
SYS<-c("C1","C2","C3")

ccdat$gains<-as.numeric(ccdat$UIL368_treat==ADT[1])
ccdat$losses<-as.numeric(ccdat$UIL368_treat==ADT[3])
ccdat$both<-as.numeric(ccdat$UIL368_treat==ADT[2])
ccdat$pick.certain<-as.numeric(ccdat$UIL368==RO1[1])
ccdat$white<-as.numeric(ccdat$race=="White")
ccdat$black<-as.numeric(ccdat$race=="Black")
ccdat$male<-as.numeric(ccdat$gender=="Male")

# separate by party
reps3<-subset(ccdat,ccdat$pid3=="Republican")
dems3<-subset(ccdat,ccdat$pid3=="Democrat")
oths3<-subset(ccdat,ccdat$pid3!="Republican"&ccdat$pid3!="Democrat")

for(r in 1:3){
  for(c in 1:2){
T1[r,c]<-sum(ccdat$teamweight[ccdat$UIL368_treat==ADT[r]
                              &ccdat$UIL368==RO1[c]],na.rm=T)
      }
}

T1R<-matrix(0,nrow=3,ncol=2)
for(r in 1:3){
  for(c in 1:2){
T1R[r,c]<-sum(reps3$teamweight[reps3$UIL368_treat==ADT[r]
                              &reps3$UIL368==RO1[c]],na.rm=T)
      }
}
T1Rp<-prop.table(T1R,1)
#round(T1Rp,2)

T1D<-matrix(0,nrow=3,ncol=2)
for(r in 1:3){
  for(c in 1:2){
T1D[r,c]<-sum(dems3$teamweight[dems3$UIL368_treat==ADT[r]
                              &dems3$UIL368==RO1[c]],na.rm=T)
      }
}
T1Dp<-prop.table(T1D,1)
#round(T1Dp,2)
T1p<-prop.table(T1,1)
#round(T1p,2)



T1O<-matrix(0,nrow=3,ncol=2)
for(r in 1:3){
  for(c in 1:2){
T1O[r,c]<-sum(oths3$teamweight[oths3$UIL368_treat==ADT[r]
                              &oths3$UIL368==RO1[c]],na.rm=T)
      }
}

T1Op<-prop.table(T1O,1)

@


%\begin{table}
%\caption{Unweighted Responses by Loss/Gain Frame}
%\label{tab:tabA1}
<<apptab1,echo=F,results='asis',message=F>>=
library(xtable)
UT<-table(ccdat$UIL368_treat,ccdat$UIL368)
AT<-round(prop.table(UT,1),2)
AT1<-rbind(AT[1,],AT[3,],AT[2,])
uNs<-c(sum(UT[1,]),sum(UT[3,]),sum(UT[2,]))
AT1<-cbind(AT1,uNs)
colnames(AT1)<-c("certain","probabilistic","N")
row.names(AT1)<-c("gains","both","losses")
xtable(AT1,
       caption = "Unweighted Responses by Frame", 
       #label = "tab:tabA1",
       digits=c(0,2,2,0))
@
%\end{table}

A test of equality between the proportions in the gains and both frames, employing a Yates continuity correction, yields a $\chi^2$ statistic of
<<chi1,echo=F,results='asis'>>=
cat(round(prop.test(c(UT[1:2,1]),c(uNs[1:2]))$stat,2)[1])
@
with 1 degree of freedom, and an associated $p$ value of
<<chi1p,echo=F,results='asis'>>=
cat(paste(round(prop.test(c(UT[1:2,1]),c(uNs[1:2]))$p.value,2)),".",sep="")
@
 The same statistics for comparison of both and losses are
 $\chi^2=$
<<chi2,echo=F,results='asis'>>=
cat(round(prop.test(c(UT[2:3,1]),c(uNs[2:3]))$stat,2)[1])
@
and $p=$
<<chi2p,echo=F,results='asis'>>=
cat(paste(round(prop.test(c(UT[2:3,1]),c(uNs[2:3]))$p.value,2)),",",sep="")
@
 respectively.Testing for equality between gains and losses yields $\chi^2=$
<<chi3,echo=F,results='asis'>>=
cat(round(prop.test(c(UT[1,1],UT[3,1]),c(uNs[1],uNs[3]))$stat,2))
@
and $p=$
<<chi3p,echo=F,results='asis'>>=
cat(paste(round(prop.test(c(UT[1,1],UT[3,1]),c(uNs[1],uNs[3]))$p.value,2),".",sep=""))
@
 
\vspace{4pt} 
Weighted counterparts, depicted in the article's Figure 1, are as shown in Table A2 below.  

<<apptab2,echo=F,results='asis',message=F>>=
library(xtable)
AT2<-round(T1p,2)
wNs<-c(sum(T1[1,]),sum(T1[2,]),sum(T1[3,]))
AT2<-cbind(AT2,round(wNs,0))
colnames(AT2)<-c("certain","probabilistic","N")
row.names(AT2)<-c("gains","both","losses")
xtable(AT2,caption = "Weighted Responses by Frame", 
       label = "tab:tabA2",digits=c(0,2,2,0))
@

A test of equality between the proportions in the gains and both frames, again employing a Yates continuity correction, yields a $\chi^2$ statistic of
<<chi1w,echo=F,results='asis'>>=
cat(round(prop.test(c(T1[1:2,1]),c(wNs[1:2]))$stat,2)[1])
@
with an associated $p$ value of
<<chi1wp,echo=F,results='asis'>>=
cat(paste(round(prop.test(c(T1[1:2,1]),c(wNs[1:2]))$p.value,2)),".",sep="")
@
 The same statistics for comparison of both and losses are $\chi^2=$
<<chi2w,echo=F,results='asis'>>=
cat(round(prop.test(c(T1[2:3,1]),c(wNs[2:3]))$stat,2)[1])
@
and $p=$
<<chi2wp,echo=F,results='asis'>>=
cat(paste(round(prop.test(c(T1[2:3,1]),c(wNs[2:3]))$p.value,2)),",",sep="")
@
 respectively.
Testing for equality between gains and losses yields $\chi^2=$
<<chi3w,echo=F,results='asis'>>=
cat(paste(round(prop.test(c(T1[1,1],T1[3,1]),c(wNs[1],wNs[3]))$stat,2)),".",sep="")
@
and $p=$
<<chi3wp,echo=F,results='asis'>>=
cat(paste((round(prop.test(c(T1[1,1],T1[3,1]),c(wNs[1],wNs[3]))$p.value,2)),".",sep=""))
@
 
\pagebreak
 
\section*{System Justification}

Respondents were completing the CES and were, accordingly, exposed to a large number of questions. Within this module, an experiment distinct from the ``Asian Disease'' replication exposed the respondents to one of three distinct openings, to place them in a mindset of system-threat, system-affirmation, or neither (as a control). Mindful that survey experiments can interfere with one another (e.g., Gaines et al. 2007, Transue et al. 2009), I checked whether these treatments appeared to affect the ADE responses.

\vspace{6pt}

The ``threat'' item was the following.
\begin{quote}
These days, many people in the United States feel disappointed with the nation’s condition. Many citizens feel that the country has reached a low point in terms of social, economic, and political factors. It seems that many countries are enjoying better social, economic, and political conditions than the U.S. More and more Americans express a willingness to leave the United States and immigrate to other nations.
\end{quote}

The ``affirming'' introduction read as follows.
\begin{quote}
These days, despite the difficulties the nation is facing, many people in the United States feel safer and more secure relative to the past. Many citizens feel that the country is relatively stable in terms of social, economic, and political factors. It seems that compared with many countries in the world the social, economic, and political conditions in the U.S. are relatively good. Very few Americans express a willingness to leave the United States and immigrate to other nations.
\end{quote}

A chi-squared test on distributions of the chosen mitigation programs across these frames supports independence, with $\chi^2(2)=$
<<systemT,echo=F,results='asis'>>=
# System Threat/Affirming
# C1 control
# C2 Systyem threat
# C3 System affirming

sysc<-subset(ccdat,ccdat$UIL301_treat=="C1")
syst<-subset(ccdat,ccdat$UIL301_treat=="C2")
sysa<-subset(ccdat,ccdat$UIL301_treat=="C3")

T1sc<-matrix(0,nrow=3,ncol=2)
for(r in 1:3){
  for(c in 1:2){
T1sc[r,c]<-sum(sysc$teamweight[sysc$UIL368_treat==ADT[r]
                              &sysc$UIL368==RO1[c]],na.rm=T)
      }
}
T1scp<-prop.table(T1sc,1)

T1st<-matrix(0,nrow=3,ncol=2)
for(r in 1:3){
  for(c in 1:2){
T1st[r,c]<-sum(syst$teamweight[syst$UIL368_treat==ADT[r]
                              &syst$UIL368==RO1[c]],na.rm=T)
      }
}
T1stp<-prop.table(T1st,1)

T1sa<-matrix(0,nrow=3,ncol=2)
for(r in 1:3){
  for(c in 1:2){
T1sa[r,c]<-sum(sysa$teamweight[sysa$UIL368_treat==ADT[r]
                              &sysa$UIL368==RO1[c]],na.rm=T)
      }
}
T1sap<-prop.table(T1sa,1)

# check for system T only
T3<-matrix(0,ncol=2,nrow=3)
T3[1,1]<-sum(T1sc[,1])
T3[1,2]<-sum(T1sc[,2])
T3[2,1]<-sum(T1st[,1])
T3[2,2]<-sum(T1st[,2])
T3[3,1]<-sum(T1sa[,1])
T3[3,2]<-sum(T1sa[,2])
cat(chisq.test(T3)$statistic)
@
with a $p$-value of
<<pv,echo=F,results='asis'>>=
cat(paste(round(chisq.test(T3)$p.value,2)),".",sep="")
@

\vspace{4pt}

If we, instead, examine the overall average treatment effects separately for each systems frame, differences are slight, as Figure A1 demonstrates.

\begin{figure}
\label{fig:sysjust}
\caption{Choices By Frames}
<<apfig,echo=F,results='asis',message=F>>=
par(mfrow=c(1,1))
plot(c(1,2,3),T1scp[,1],ylim=c(0,1),xaxt='n',
     pch=20,xlim=c(0.5,3.5),ylab="Proportion Selecting Risk-Averse Option",
      xlab="ADE frame")
#points(c(1,1),prop.test(T1sc[1,1],sum(T1sc[1,]))$conf.int,pch="-")
lines(c(1,1),prop.test(T1sc[1,1],sum(T1sc[1,]))$conf.int)
#points(c(2,2),prop.test(T1sc[2,1],sum(T1sc[2,]))$conf.int,pch="-")
lines(c(2,2),prop.test(T1sc[2,1],sum(T1sc[2,]))$conf.int)
#points(c(3,3),prop.test(T1sc[3,1],sum(T1sc[3,]))$conf.int,pch="-")
lines(c(3,3),prop.test(T1sc[3,1],sum(T1sc[3,]))$conf.int)
text(1,0.05,"gains",cex=.9)
text(2,0.05,"both",cex=.9)
text(3,0.05,"losses",cex=.9)

points(c(1.1,2.1,3.1),T1stp[,1],col="red")
#points(c(1.1,1.1),prop.test(T1st[1,1],sum(T1st[1,]))$conf.int,pch="-",col="red")
lines(c(1.1,1.1),prop.test(T1st[1,1],sum(T1st[1,]))$conf.int,
      col="red")
#points(c(2.1,2.1),prop.test(T1st[2,1],
#                  sum(T1st[2,]))$conf.int,pch="-",col="red")
lines(c(2.1,2.1),prop.test(T1st[2,1],sum(T1st[2,]))$conf.int,
      col="red")
#points(c(3.1,3.1),prop.test(T1st[3,1],
#          sum(T1st[3,]))$conf.int,pch="-",col="red")
lines(c(3.1,3.1),prop.test(T1st[3,1],
                        sum(T1st[3,]))$conf.int,col="red")

points(c(1.2,2.2,3.2),T1sap[,1],col="blue")
#points(c(1.2,1.2),prop.test(T1sa[1,1],sum(T1sa[1,]))$conf.int,
#       pch="-",col="blue")
lines(c(1.2,1.2),prop.test(T1sa[1,1],sum(T1sa[1,]))$conf.int,
      col="blue")
#points(c(2.2,2.2),prop.test(T1sa[2,1],sum(T1sa[2,]))$conf.int,
#       pch="-",col="blue")
lines(c(2.2,2.2),prop.test(T1sa[2,1],sum(T1sa[2,]))$conf.int,
      col="blue")
#points(c(3.2,3.2),prop.test(T1sa[3,1],sum(T1sa[3,]))$conf.int,
#       pch="-",col="blue")
lines(c(3.2,3.2),prop.test(T1sa[3,1],sum(T1sa[3,]))$conf.int,
      col="blue")

text(.9,.95,"control")
text(1.2,.91,"threat",col="red")
text(1.4,.87,"affirm",col="blue")


@
\end{figure}

\pagebreak

\section*{Framing Effects By Personal Experience with Covid}

Program choices were very similar for those who reported knowing someone (friend, co-worker or family member) who had had COVID or having had it themselves and for those who did not. Weighted proportions are shown in Tables A3 and A4 below. Tables A5 and A6 show weighted proportions according to subjects' self-reported experience of knowing someone who died of COVID.


<<apptab3,echo=F,results='asis',message=F>>=
library(xtable)
# separate by knowing anyone (incl self)
#  diagnosed w Covid
come<-2-as.numeric(ccdat$CC20_309a_1)
cofam<-2-as.numeric(ccdat$CC20_309a_2)
cofrd<-2-as.numeric(ccdat$CC20_309a_3)
cowrk<-2-as.numeric(ccdat$CC20_309a_4)
coany<-as.numeric(come+cofam+cofrd+cowrk>0)
cono<-2-as.numeric(ccdat$CC20_309a_5)
# no inconsistency!
#table(coany,cono)


Tk.y<-matrix(0,nrow=3,ncol=2)
Tk.n<-matrix(0,nrow=3,ncol=2)

for(r in 1:3){
  for(c in 1:2){
Tk.y[r,c]<-sum(ccdat$teamweight[ccdat$UIL368_treat==ADT[r]
                                &ccdat$UIL368==RO1[c]
                                &cono==0],na.rm=T)
Tk.n[r,c]<-sum(ccdat$teamweight[ccdat$UIL368_treat==ADT[r]
                                &ccdat$UIL368==RO1[c]
                                &cono==1],na.rm=T)
      }
}

T3ap<-prop.table(Tk.y,1)
AT3a<-round(T3ap,2)
wNs3a<-c(sum(Tk.y[1,]),sum(Tk.y[2,]),sum(Tk.y[3,]))
AT3a<-cbind(AT3a,round(wNs3a,0))
colnames(AT3a)<-c("certain","probabilistic","N")
row.names(AT3a)<-c("gains","both","losses")
xtable(AT3a,caption = "Weighted Responses by Frame, with COVID-positive Acquaintances", 
       label = "tab:tabA3",digits=c(0,2,2,0))

T4p<-prop.table(Tk.n,1)
AT4<-round(T4p,2)
wNs4<-c(sum(Tk.n[1,]),sum(Tk.n[2,]),sum(Tk.n[3,]))
AT4<-cbind(AT4,round(wNs4,0))
colnames(AT4)<-c("certain","probabilistic","N")
row.names(AT4)<-c("gains","both","losses")
xtable(AT4,caption = "Weighted Responses by Frame, w/o COVID-pos. Acquaintances", 
       label = "tab:tabA3b",digits=c(0,2,2,0))
@


<<anotherchunk,echo=F,results='asis'>>==
# separate effects by reporting having had family, friend or co-worker
# die of Covid
# seeming errors in not-selected
# s+not-s do not sum to anywhere near 500
# except for "no" (b_4)
codifam<-1-as.numeric(as.numeric(ccdat$CC20_309b_4)>0)
codifrd<-codifam
codiwrk<-codifam
codifam[as.numeric(ccdat$CC20_309b_1)==1]<-1
codifrd[as.numeric(ccdat$CC20_309b_2)==1]<-1
codiwrk[as.numeric(ccdat$CC20_309b_3)==1]<-1
codiany<-as.numeric((codifam+codifrd+codiwrk)>0)
codino<-2-as.numeric(ccdat$CC20_309b_4)

Td.y<-matrix(0,nrow=3,ncol=2)
Td.n<-matrix(0,nrow=3,ncol=2)

for(r in 1:3){
  for(c in 1:2){
Td.y[r,c]<-sum(ccdat$teamweight[ccdat$UIL368_treat==ADT[r]
                                &ccdat$UIL368==RO1[c]
                                &codino==0],na.rm=T)
Td.n[r,c]<-sum(ccdat$teamweight[ccdat$UIL368_treat==ADT[r]
                                &ccdat$UIL368==RO1[c]
                                &codino==1],na.rm=T)
      }
}
T5p<-prop.table(Td.y,1)
AT5<-round(T5p,2)
wNs5<-c(sum(Td.y[1,]),sum(Td.y[2,]),sum(Td.y[3,]))
AT5<-cbind(AT5,round(wNs5,0))
colnames(AT5)<-c("certain","probabilistic","N")
row.names(AT5)<-c("gains","both","losses")
xtable(AT5,caption = "Weighted Responses by Frame, Acquaintances died from COVID", 
       label = "tab:tabA5",digits=c(0,2,2,0))

T6p<-prop.table(Td.n,1)
AT6<-round(T6p,2)
wNs6<-c(sum(Td.n[1,]),sum(Td.n[2,]),sum(Td.n[3,]))
AT6<-cbind(AT6,round(wNs6,0))
colnames(AT6)<-c("certain","probabilistic","N")
row.names(AT6)<-c("gains","both","losses")
xtable(AT6,caption = "Weighted Responses by Frame, No Acquaintances died from COVID", 
       label = "tab:tabA6",digits=c(0,2,2,0))
@



\pagebreak

\section*{Results by Partisanship}

Figure~\ref{fig:ptyate} shows ATEs for the subsets of self-identified Democrats, Republicans, and independents separately. This figure uses only the first question from the standard ``partisan identification'' battery, pooling together pure independents and ``leaners.'' 

Patterns for Republicans and independents do not match those from the original ADE. Democrats do exhibit monotonic decrease in risk-averse proportions, comparing gains to both to losses, but the gaps are modest.

\begin{figure}
\caption{Treatment Effects by Respondent's Party}
\label{fig:ptyate}
<<fig2,echo=F,results='asis'>>=
# Fig.2, separate by party
plot(c(1,2,3),T1Rp[,1],ylim=c(0,1),xaxt='n',
     pch=20,col="red",xlim=c(0.5,3.5),
     ylab="Proportion Selecting Certain Option",
      xlab="Frame")
text(1,0.05,"gains",cex=.9)
text(2,0.05,"both",cex=.9)
text(3,0.05,"losses",cex=.9)
points(c(1.1,2.1,3.1),T1Op[,1],pch=15,col="purple")
points(c(1.2,2.2,3.2),T1Dp[,1],pch=18,col="blue")

for(r in 1:2){
  for(c in 1:3){
lines(c(c,c),prop.test(T1R[c,1],sum(T1R[c,]))$conf.int,
      col="red")
lines(c(c+.2,c+.2),prop.test(T1D[c,1],sum(T1D[c,]))$conf.int,
      col="blue")
lines(c(c+.1,c+.1),prop.test(T1O[c,1],sum(T1O[c,]))$conf.int,
      col="purple")
    }
}
text(.93,.3,"Rep.",col="red",cex=0.8)
text(1.1,.27,"other",col="purple",cex=0.8)
text(1.24,.3,"Dem.",col="blue",cex=0.8)

dev.off()
@
\title{\small{\sffamily{Data points are proportions selecting the certain option for the given frame and party identification, with a 95-percent-confidence interval. Republicans (left) are circles, others (middle) are squares, and Democrats (right) are diamonds.}}}
\end{figure}


Bayes factors for the primary comparison, of the gains and losses frames, for the Democrats, independents, and Republicans, respectively, are: 
<<bfbyparty,echo=F,results='asis'>>=
ddata.gl <- list(y1 = round(T1D[1,1],0), n1 = round(sum(T1D[1,]),0),
                y2 = round(T1D[3,1],0), n2 = round(sum(T1D[3,]),0))
ddata.gb <- list(y1 = round(T1D[1,1],0), n1 = round(sum(T1D[1,]),0),
                y2 = round(T1D[2,1],0), n2 = round(sum(T1D[2,]),0))
ddata.lb <- list(y1 = round(T1D[3,1],0), n1 = round(sum(T1D[3,]),0),
                y2 = round(T1D[2,1],0), n2 = round(sum(T1D[2,]),0))

dgl <- ab_test(data = ddata.gl)
dgb <- ab_test(data = ddata.gb)
dlb <- ab_test(data = ddata.lb)

idata.gl <- list(y1 = round(T1O[1,1],0), n1 = round(sum(T1O[1,]),0),
                y2 = round(T1O[3,1],0), n2 = round(sum(T1O[3,]),0))
idata.gb <- list(y1 = round(T1O[1,1],0), n1 = round(sum(T1O[1,]),0),
                y2 = round(T1O[2,1],0), n2 = round(sum(T1O[2,]),0))
idata.lb <- list(y1 = round(T1O[3,1],0), n1 = round(sum(T1O[3,]),0),
                y2 = round(T1O[2,1],0), n2 = round(sum(T1O[2,]),0))

igl <- ab_test(data = idata.gl)
igb <- ab_test(data = idata.gb)
ilb <- ab_test(data = idata.lb)

rdata.gl <- list(y1 = round(T1R[1,1],0), n1 = round(sum(T1R[1,]),0),
                y2 = round(T1R[3,1],0), n2 = round(sum(T1R[3,]),0))
rdata.gb <- list(y1 = round(T1R[1,1],0), n1 = round(sum(T1R[1,]),0),
                y2 = round(T1R[2,1],0), n2 = round(sum(T1R[2,]),0))
rdata.lb <- list(y1 = round(T1R[3,1],0), n1 = round(sum(T1R[3,]),0),
                y2 = round(T1R[2,1],0), n2 = round(sum(T1R[2,]),0))

rgl <- ab_test(data = rdata.gl)
rgb <- ab_test(data = rdata.gb)
rlb <- ab_test(data = rdata.lb)

txt<-paste(round(as.numeric(dgl$bf[1]),2),", ",round(as.numeric(igl$bf[1]),2),
      ", and ",round(as.numeric(rgl$bf[1]),2),".",sep="")
cat(txt)
@
Democrats thus provided strong evidence for a much-diminished original effect, whereas the data for the other respondents better support the opposite conclusion. Partisanship not being randomly assigned, below we show models of the framing effect for partisans net of various possible confounders.

Figure ~\ref{fig:pty7ate} shows responses by frames for all seven of the standard NES party-identification categories, none of which match the original Tversky and Kahneman pattern very well.

\begin{figure}[H]
\caption{Treatment Effects by Respondent's Party}
\label{fig:pty7ate}
<<figA2,echo=F,results='asis'>>=
# Fig.A2, separate by party 7

# separate by party
stgreps<-subset(ccdat,ccdat$pid7=="Strong Republican")
reps<-subset(ccdat,ccdat$pid7=="Not very strong Republican")
indreps<-subset(ccdat,ccdat$pid7=="Lean Republican")
inds<-subset(ccdat,ccdat$pid7=="Independent" |
               ccdat$pid7=="Not sure")
inddems<-subset(ccdat,ccdat$pid7=="Lean Democrat")
dems<-subset(ccdat,ccdat$pid7=="Not very strong Democrat")
stgdems<-subset(ccdat,ccdat$pid7=="Strong Democrat")

#STG REPS
T1SR<-matrix(0,nrow=3,ncol=2)
for(r in 1:3){
  for(c in 1:2){
T1SR[r,c]<-sum(stgreps$teamweight[stgreps$UIL368_treat==ADT[r]
                              &stgreps$UIL368==RO1[c]],na.rm=T)
      }
}
T1SRp<-prop.table(T1SR,1)

#REPS
T1R<-matrix(0,nrow=3,ncol=2)
for(r in 1:3){
  for(c in 1:2){
T1R[r,c]<-sum(reps$teamweight[reps$UIL368_treat==ADT[r]
                              &reps$UIL368==RO1[c]],na.rm=T)
      }
}
T1Rp<-prop.table(T1R,1)

#INDREPS
T1IR<-matrix(0,nrow=3,ncol=2)
for(r in 1:3){
  for(c in 1:2){
T1IR[r,c]<-sum(indreps$teamweight[indreps$UIL368_treat==ADT[r]
                              &indreps$UIL368==RO1[c]],na.rm=T)
      }
}
T1IRp<-prop.table(T1IR,1)

#INDS
T1I<-matrix(0,nrow=3,ncol=2)
for(r in 1:3){
  for(c in 1:2){
T1I[r,c]<-sum(inds$teamweight[inds$UIL368_treat==ADT[r]
                              &inds$UIL368==RO1[c]],na.rm=T)
      }
}
T1Ip<-prop.table(T1I,1)

#INDDEMS
T1ID<-matrix(0,nrow=3,ncol=2)
for(r in 1:3){
  for(c in 1:2){
T1ID[r,c]<-sum(inddems$teamweight[inddems$UIL368_treat==ADT[r]
                              &inddems$UIL368==RO1[c]],na.rm=T)
      }
}
T1IDp<-prop.table(T1ID,1)

#DEMS
T1D<-matrix(0,nrow=3,ncol=2)
for(r in 1:3){
  for(c in 1:2){
T1D[r,c]<-sum(dems$teamweight[dems$UIL368_treat==ADT[r]
                              &dems$UIL368==RO1[c]],na.rm=T)
      }
}
T1Dp<-prop.table(T1D,1)

#STGDEMS
T1SD<-matrix(0,nrow=3,ncol=2)
for(r in 1:3){
  for(c in 1:2){
T1SD[r,c]<-sum(stgdems$teamweight[stgdems$UIL368_treat==ADT[r]
                              &stgdems$UIL368==RO1[c]],na.rm=T)
      }
}
T1SDp<-prop.table(T1SD,1)


plot(c(.8,1.8,2.8),T1SRp[,1],ylim=c(0,1),xaxt='n',
     pch=20,col="red",xlim=c(0.5,3.5),
     ylab="Proportion Risk-Averse",
    xlab="")
text(1,0.05,"gains",cex=.9)
text(2,0.05,"both",cex=.9)
text(3,0.05,"losses",cex=.9)
points(c(.9,1.9,2.9),T1Rp[,1],pch=20,col="pink")
points(c(1,2,3),T1IRp[,1],pch=20,col="maroon2")
points(c(1.1,2.1,3.1),T1Ip[,1],pch=20,col="purple")
points(c(1.2,2.2,3.2),T1IDp[,1],pch=20,col="mediumpurple1")
points(c(1.3,2.3,3.3),T1Dp[,1],pch=20,col="blue")
points(c(1.4,2.4,3.4),T1SDp[,1],pch=20,col="blue4")

for(c in 1:3){
lines(c(c-.2,c-.2),prop.test(T1SR[c,1],sum(T1SR[c,]))$conf.int,
      col="red")
lines(c(c-.1,c-.1),prop.test(T1R[c,1],sum(T1R[c,]))$conf.int,
      col="pink")
lines(c(c,c),prop.test(T1IR[c,1],sum(T1IR[c,]))$conf.int,
      col="maroon2")
lines(c(c+.1,c+.1),prop.test(T1I[c,1],sum(T1I[c,]))$conf.int,
      col="purple")
lines(c(c+.2,c+.2),prop.test(T1ID[c,1],sum(T1ID[c,]))$conf.int,
      col="mediumpurple")
lines(c(c+.3,c+.3),prop.test(T1D[c,1],sum(T1D[c,]))$conf.int,
      col="blue")
lines(c(c+.4,c+.4),prop.test(T1SD[c,1],sum(T1SD[c,]))$conf.int,
      col="blue4")
}
text(.75,.2,"SR",col="red",cex=0.8)
text(.9,.2,"R",col="pink",cex=0.8)
text(1,.2,"IR",col="maroon4",cex=0.8)
text(1.1,.2,"I",col="purple",cex=0.8)
text(1.2,.2,"ID",col="mediumpurple",cex=0.8)
text(1.3,.2,"D",col="blue",cex=0.8)
text(1.45,.2,"SD",col="blue4",cex=0.8)

#dev.off()
@
\end{figure}

The partisan groups compared in Figure A2 are, of course, observed, not formed by random assignment. And the proportions are not adjusted for any covariates. Probit models shown below confirm that the gains-versus-losses differences for Republicans and independents are not statistically significant, whereas those for Democrats are, even when permitting distinct sex, race, and education effects.

<<regforparty,echo=F,results='asis',message=FALSE>>=

ccdat$Democrat<-as.numeric(ccdat$pid3=="Democrat")
ccdat$Republican<-as.numeric(ccdat$pid3=="Republican")

library(glm2)
pro2r<-glm(pick.certain~gains+both+white+black+male+educ,
          family = binomial(link = "probit"), data=reps3)
pro2d<-glm(pick.certain~gains+both+white+black+male+educ,
          family = binomial(link = "probit"), data=dems3)
pro2o<-glm(pick.certain~gains+both+white+black+male+educ,
          family = binomial(link = "probit"), data=oths3)
library(stargazer)
stargazer(pro2r,title="Republicans",dep.var.labels="pick certain")
stargazer(pro2d,title="Democrats",dep.var.labels="pick certain")
stargazer(pro2o,title="others",dep.var.labels="pick certain")
@

\pagebreak

\section*{Sources}

\vspace{6pt}
\hangindent=\parindent
\hangafter=1
\noindent{Gaines, Brian J., James H. Kuklinski, \& Paul J. Quirk. 2007. The Logic of the Survey Experiment Reexamined. {\it Political Analysis} 15,1: 1-20.}

\vspace{6pt}
\hangindent=\parindent
\hangafter=1
\noindent{Transue, John E., Daniel J. Lee, \& John H. Aldrich. 2009. Treatment Spillover Effects Across Survey Experiments. {\it Political Analysis} 17,2: 143-161.}

\end{document}